home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / floats.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  2.6 KB  |  148 lines  |  [TEXT/R*ch]
  1. #include <math.h>
  2. #include <stdio.h>
  3. #include "alloc.h"
  4. #include "debugger.h"
  5. #include "fail.h"
  6. #include "memory.h"
  7. #include "misc.h"
  8. #include "mlvalues.h"
  9.  
  10. #ifdef ALIGN_DOUBLE
  11.  
  12. double Double_val(val)
  13.      value val;
  14. {
  15.   union { value v[2]; double d; } buffer;
  16.  
  17.   Assert(sizeof(double) == 2 * sizeof(value));
  18.   buffer.v[0] = Field(val, 0);
  19.   buffer.v[1] = Field(val, 1);
  20.   return buffer.d;
  21. }
  22.  
  23. void Store_double_val(val, dbl)
  24.      value val;
  25.      double dbl;
  26. {
  27.   union { value v[2]; double d; } buffer;
  28.  
  29.   Assert(sizeof(double) == 2 * sizeof(value));
  30.   buffer.d = dbl;
  31.   Field(val, 0) = buffer.v[0];
  32.   Field(val, 1) = buffer.v[1];
  33. }
  34.  
  35. #endif
  36.  
  37. value format_float(fmt, arg)    /* ML */
  38.      value fmt, arg;
  39. {
  40.   char format_buffer[64];
  41.   int prec, i;
  42.   char * p;
  43.   char * dest;
  44.   value res;
  45.  
  46.   prec = 64;
  47.   for (p = String_val(fmt); *p != 0; p++) {
  48.     if (*p >= '0' && *p <= '9') {
  49.       i = atoi(p) + 15;
  50.       if (i > prec) prec = i;
  51.       break;
  52.     }
  53.   }
  54.   for( ; *p != 0; p++) {
  55.     if (*p == '.') {
  56.       i = atoi(p+1) + 15;
  57.       if (i > prec) prec = i;
  58.       break;
  59.     }
  60.   }
  61.   if (prec <= sizeof(format_buffer)) {
  62.     dest = format_buffer;
  63.   } else {
  64.     dest = stat_alloc(prec);
  65.   }
  66.   sprintf(dest, String_val(fmt), Double_val(arg));
  67.   res = copy_string(dest);
  68.   if (dest != format_buffer) {
  69.     stat_free(dest);
  70.   }
  71.   return res;
  72. }
  73.  
  74. value float_of_string(s)        /* ML */
  75.      value s;
  76. {
  77. #ifndef __MWERKS__
  78.   extern double atof();
  79. #endif
  80.   return copy_double(atof(String_val(s)));
  81. }
  82.  
  83. value exp_float(f)              /* ML */
  84.      value f;
  85. {
  86.   return copy_double(exp(Double_val(f)));
  87. }
  88.  
  89. value log_float(f)              /* ML */
  90.      value f;
  91. {
  92.   return copy_double(log(Double_val(f)));
  93. }
  94.  
  95. value sqrt_float(f)             /* ML */
  96.      value f;
  97. {
  98.   return copy_double(sqrt(Double_val(f)));
  99. }
  100.  
  101. value power_float(f, g)         /* ML */
  102.      value f, g;
  103. {
  104.   return copy_double(pow(Double_val(f), Double_val(g)));
  105. }
  106.  
  107. value sin_float(f)              /* ML */
  108.      value f;
  109. {
  110.   return copy_double(sin(Double_val(f)));
  111. }
  112.  
  113. value cos_float(f)              /* ML */
  114.      value f;
  115. {
  116.   return copy_double(cos(Double_val(f)));
  117. }
  118.  
  119. value tan_float(f)              /* ML */
  120.      value f;
  121. {
  122.   return copy_double(tan(Double_val(f)));
  123. }
  124.  
  125. value asin_float(f)             /* ML */
  126.      value f;
  127. {
  128.   return copy_double(asin(Double_val(f)));
  129. }
  130.  
  131. value acos_float(f)             /* ML */
  132.      value f;
  133. {
  134.   return copy_double(acos(Double_val(f)));
  135. }
  136.  
  137. value atan_float(f)             /* ML */
  138.      value f;
  139. {
  140.   return copy_double(atan(Double_val(f)));
  141. }
  142.  
  143. value atan2_float(f, g)        /* ML */
  144.      value f, g;
  145. {
  146.   return copy_double(atan2(Double_val(f), Double_val(g)));
  147. }
  148.